#!/opt/local/bin/perl -w
use strict;

use ChadoConnect;
my $dbh = ChadoConnect::make_con($ARGV[0]);

# Note - joins to find ids have been commented.  But Kathleen is worried about ambiguity when given names only.  One way to deal with this is to roll a name_id hash - with a warning or error thrown id dup name is found.  Highly unlikely, but should be easy to implement.
my  $sth = $dbh->prepare('SELECT p.phenotype_id as pid, p.uniquename AS uname,
a.name AS aname, 
adb.name AS aidp,  adbx.accession as aid, 
phenc.name AS phencname, 
phencdb.name AS phencidp, 
phencdbx.accession as phencid,
q.name AS qname, 
qdb.name AS qidp,
qdbx.accession as qid
FROM phenotype p
JOIN cvterm a ON (p.observable_id=a.cvterm_id)
JOIN dbxref adbx ON (a.dbxref_id=adbx.dbxref_id)
JOIN db adb ON (adbx.db_id=adb.db_id)
JOIN cvterm phenc ON (p.cvalue_id=phenc.cvterm_id)
JOIN dbxref phencdbx ON (phenc.dbxref_id=phencdbx.dbxref_id)
JOIN db phencdb ON (phencdbx.db_id=phencdb.db_id)
LEFT OUTER JOIN phenotype_cvterm pc on (p.phenotype_id=pc.phenotype_id)
JOIN cvterm q ON (pc.cvterm_id=q.cvterm_id)
JOIN dbxref qdbx ON (q.dbxref_id=qdbx.dbxref_id)
JOIN db qdb ON (qdbx.db_id=qdb.db_id)
WHERE p.uniquename like \'%expression%\''); # wild card match finds appropriate phenotype lines

my %phen;
# $phen{$pid} = { 'primary_term' => $name, 'uname' =>  $uname, 'qlist' => [ $qname1, $quname2...etc ] }
my %name_id;

# my %cvterm;
$sth->execute or die "WARNING: ERR: Unable to execute query\n";
while (my $hash_ref = $sth->fetchrow_hashref) {
  my $pid = $hash_ref->{'pid'};
  $phen{$pid}{'uname'} = $hash_ref->{'uname'};
  if ($hash_ref->{'aname'} ne 'unspecified') {
    $phen{$pid}{'primary_term'} = $hash_ref->{'aname'};
    &name_id_track($hash_ref->{'aname'},  $hash_ref->{'aidp'}, $hash_ref->{'aid'})
  } elsif ($hash_ref->{'phencname'} ne 'unspecified') {
    $phen{$pid}{'primary_term'} = $hash_ref->{'phencname'};
    &name_id_track($hash_ref->{'phencname'},  $hash_ref->{'phencidp'}, $hash_ref->{'phencid'})
  } else {
    print STDERR "Phenotype $hash_ref->{'uname'} has no primary term!\n"
  }
  if ($hash_ref->{'qname'}) {
    push @{$phen{$pid}->{'q_list'}}, $hash_ref->{'qname'};
    &name_id_track($hash_ref->{'qname'},  $hash_ref->{'qidp'}, $hash_ref->{'qid'})
  } 
}

my %mapping = (
'even pair rule expression pattern' => 'even pair-rule phenotype',
'odd pair rule expression pattern' => 'odd pair-rule phenotype',
'gap expression pattern' => 'gap phenotype',
'segment polarity expression pattern' => 'segment polarity phenotype',
'terminal expression pattern' => 'terminal phenotype',
'pair rule expression pattern' => 'pair rule phenotype',
);

my ($key, $value);
while (($key, $value) = each %mapping) {
  $sth = $dbh->prepare('SELECT db.name as idp, dbx.accession as acc
FROM cvterm c, dbxref dbx, db
WHERE c.dbxref_id = dbx.dbxref_id
AND dbx.db_id = db.db_id
AND c.name = \''.$value.'\'');
  $sth->execute or die "WARNING: ERR: Unable to execute query\n";
  while (my $hash_ref = $sth->fetchrow_hashref) {
    $name_id{$value}=$hash_ref->{'idp'}.':'.$hash_ref->{'acc'};
  }
}

print "p.phenotype_id\tp.uniquename\tnew p.uniquename 1\tnew phenotype uniquename 2\tname ; id pairs\n";
my $pid;
while (($pid, $value) = each %phen) { 
  my %local_name_id;
  $local_name_id{$value->{'primary_term'}} = $name_id{$value->{'primary_term'}};
  my $new_uname1 = $value->{'primary_term'};
  my $new_uname2;
  my @new_qlist;
  for (@{$value->{'q_list'}}) {
    if (exists $mapping{$_}) {
      $new_uname2 = $mapping{$_};
      $local_name_id{$mapping{$_}} = $name_id{$mapping{$_}}
    } else {
      push @new_qlist, $_;
      $local_name_id{$_} = $name_id{$_}
    }
  }
  my @new_qlist_sorted = sort (@new_qlist);
  for (@new_qlist_sorted) {
    $new_uname1 .= " \| $_";
    $new_uname2 .= " \| $_";
  }
  print "$pid\t$value->{'uname'}\t$new_uname1\t$new_uname2\t";
  my ($name, $id);
  while (($name, $id) = each %local_name_id) {
    print "$name ; $id";
    print ", "
  }
  print "\n"
}

sub name_id_track {
  # Warning - uses global hash !!
  my $name = shift;
  my $idp = shift;
  my $acc = shift;
   if ((exists $name_id{$name})&&($name_id{$name} ne "$idp:$acc")) {  # parnoid check for dup ids
    die "\nname clash - $name has more than one id\n" 
  } else {
    $name_id{$name} = "$idp:$acc";
  }
}
